home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
TIPS
/
VALID.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-10-09
|
4KB
|
147 lines
{************************************************}
{ }
{ Turbo Pascal for Windows }
{ Tips & Techniques Demo Program }
{ Copyright (c) 1991 by Borland International }
{ }
{************************************************}
program Valid;
{$R Valid}
uses WinTypes, WinProcs, WObjects, Strings;
const
FieldWidth = 6;
type
PEditInteger=^TEditInteger;
TEditInteger=object(TEdit)
constructor Init(AParent: PWindowsObject; AnId: Integer;
AValue: Integer; X, Y, W, H: Integer);
function CanClose: boolean; virtual;
function Transfer(DataPtr: Pointer; Transferflag: Word): Word; virtual;
end;
constructor TEditInteger.Init(AParent: PWindowsObject; AnId: Integer;
AValue: Integer; X, Y, W, H: Integer);
var
InitValue: PChar;
TempStr: String;
begin
GetMem(InitValue, FieldWidth + 1);
Str(AValue, TempStr);
StrPCopy(InitValue, TempStr);
TEdit.Init(AParent, AnId, InitValue, X, Y, W, H, FieldWidth, false);
FreeMem(InitValue, FieldWidth + 1);
end;
function TEditInteger.Transfer(DataPtr: Pointer; Transferflag: Word): word;
type
PInteger=^Integer;
var
Value: PChar;
TempStr: String;
Result: Longint;
Code: Integer;
begin
case Transferflag of
tf_GetData:
begin
GetMem(Value, TEdit.Transfer(nil, tf_SizeData));
TEdit.Transfer(Value, tf_GetData);
TempStr:=StrPas(Value);
Val(TempStr, Result, Code);
if code<>0 then
Transfer:=0
else
begin
if (Result>32767) or (Result<-32768) then
Transfer:=0
else
begin
PInteger(DataPtr)^:=Result;
Transfer:=SizeOf(Integer);
end;
end;
end;
tf_SetData:
begin
Str(PInteger(DataPtr)^, TempStr);
GetMem(Value, FieldWidth + 1);
StrPCopy(Value, TempStr);
TEdit.Transfer(Value, tf_SetData);
Transfer:=2;
FreeMem(Value, FieldWidth + 1);
end;
tf_SizeData: Transfer:=SizeOf(Integer);
end;
end;
function TEditInteger.CanClose: boolean;
var
Value:^Integer;
Result: Word;
begin
New(Value);
Result:=Transfer(Value, tf_GetData);
if Result=0 then
begin
MessageBox(Application^.MainWindow^.HWindow, 'Integer Expected', nil,
mb_Ok or mb_IconStop);
SetFocus(HWindow);
end;
CanClose:=Result<>0;
end;
const
cm_Valid = 100;
type
PMainWindow = ^TMainWindow;
TMainWindow = object(TWindow)
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure CMValid(var Msg: TMessage);
virtual cm_First + cm_Valid;
end;
constructor TMainWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
TWindow.Init(AParent, ATitle);
Attr.Menu:=LoadMenu(HInstance,'MAINMENU');
end;
procedure TMainWindow.CMValid(var Msg: TMessage);
var
Dialog: PDialog;
EditInteger: PEditInteger;
Buffer: Integer;
begin
New(Dialog, Init(@Self, 'Valid'));
EditInteger:=New(PEditInteger, InitResource(Dialog, 102, FieldWidth));
Buffer:=0;
Dialog^.TransferBuffer:=@Buffer;
Application^.ExecDialog(Dialog);
end;
type
TApp = object(TApplication)
procedure InitMainWindow; virtual;
end;
procedure TApp.InitMainWindow;
begin
MainWindow:=new(PMainWindow, Init(nil, 'Validate Integer'));
end;
var
App: TApp;
begin
App.Init('Valid');
App.Run;
App.Done;
end.